Map and data setup

Loading map from library(maps) for drawing the maps.

usa <- map_data("usa")
states <- map_data("state")

theme_map <- function(...) {
  theme_minimal() +
  theme(
    axis.line = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    # panel.grid.major = element_line(color = "#ebebe5", size = 0.2),
    panel.grid.major = element_blank(),    
    panel.grid.minor = element_blank(),
    panel.border = element_blank(),
    ...
  )
}

Load state’s community mobility data from google’s PDFs (extracted with scripts/getdata.R).

• Note: There were data available for Alaska and Hawaii, but since it won’t be mapped, they were removed here.

odf <- read.csv("./data/state_mobility_google_map_3_29.csv")

df <- odf %>% filter(!is.element(odf$states, c("Alaska", "Hawaii"))) # take out alaska & hawaii just for mapping # also we don't have DC

df$states <- tolower(df$states)
df$states <- gsub("_", " ", df$states)

# check all states are present
# sum(is.element(df$states, unique(states$region)))/48

• Merge data from community mobility report to state’s lat/long data frame
• Reshape data from wide to long format for plotting
• Rename/recode variables

ns <- data.frame(states, retail=NA, grocery=NA, parks=NA, transit=NA, workplace=NA, residence=NA)

for(i in 1:nrow(ns)){
  if(ns$region[i]=="district of columbia"){
      ns[i,7:ncol(ns)] <- NA
  }else{
      ns[i,7:ncol(ns)] <- as.character(unlist(df[df$states==ns$region[i],2:ncol(df)]))
  }
}

for(j in 7:ncol(ns)){
  ns[,j] <- as.numeric(sub("%", "",ns[,j]))
}

ns[,7:ncol(ns)] <- ns[,7:ncol(ns)] *.01

#  Gather to long form
ldf <- ns %>% 
  gather(data = ., key = "Type", value = "Percent_Change", retail:residence, factor_key = T)

ldf$Type<- recode(ldf$Type,
         retail="Retail & recreation", 
         grocery="Grocery & pharmacy",
         parks="Parks", 
         transit="Transit stations", 
         workplace="Workplaces", 
         residence="Residential")

Maps

The colors in the map indicates % change in visits to different categories of places (e.g., grocery, parks), comparing Mar.29 to a baseline value = median of Jan 3-Feb 6

lp <- ldf %>% 
  filter(!is.element(Type, c("Parks", "Residential"))) %>%
  ggplot(aes(text = region)) + 
    geom_polygon(aes(x = long, y = lat, group = group, fill=Percent_Change), color = "white") + 
    coord_fixed(1.3) +
    scale_fill_gradient(low = "navyblue", high = "white", lim=c(-.80,0),
                         labels = scales::percent) +
    labs(fill = "% change in \nvisits") +
    facet_wrap(~Type) +
    theme_map()

ggsave(filename = "./figs/reduced_map.png", lp) # for README

lpy <- ggplotly(lp)

lpy

lp <- ldf %>% 
  filter(is.element(Type, c("Residential"))) %>%
  ggplot(aes(text = region)) + 
    geom_polygon(aes(x = long, y = lat, group = group, fill=Percent_Change), color = "white") + 
    coord_fixed(1.3) +
    scale_fill_gradient(low = "white",high = "firebrick", lim=c(0,.25),
                         labels = scales::percent) +
    facet_wrap(~Type) + 
    labs(fill = "% change in \nvisits") +
    theme_map() 

ggsave(filename = "./figs/increased_map.png", lp) # for README

lpy <- ggplotly(lp)

lpy

lp <- ldf %>% 
  filter(is.element(Type, c("Parks"))) %>%
  ggplot(aes(text = region)) + 
    geom_polygon(aes(x = long, y = lat, group = group, fill=Percent_Change), color = "white") + 
    coord_fixed(1.3) +
    scale_fill_gradient2(low = "navyblue", mid="white",high = "firebrick", lim=c(-.80,.80),
                         labels = scales::percent) +
    facet_wrap(~Type) + 
    labs(fill = "% change in \nvisits") +
    theme_map()


ggsave(filename = "./figs/mixed_map.png", lp)

lpy <- ggplotly(lp)

lpy